home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dbase
/
lib19.zip
/
CONVERT.PRG
< prev
next >
Wrap
Text File
|
1992-08-11
|
26KB
|
735 lines
*-------------------------------------------------------------------------------
*-- Program...: CONVERT.PRG
*-- Programmer: Ken Mayer (KENMAYER)
*-- Date......: 06/25/1992
*-- Notes.....: This is the numeric conversion/calculation library file. See
*-- the file README.TXT for details on the use of this file.
*-------------------------------------------------------------------------------
FUNCTION Roman
*-------------------------------------------------------------------------------
*-- Programmer..: Nick Carlin
*-- Date........: 04/26/1992
*-- Notes.......: A function designed to return a Roman Numeral based on
*-- an Arabic Numeral input ...
*-- Written for.: dBASE III+
*-- Rev. History: 04/13/1988 - original function.
*-- 07/25/1991 - Ken Mayer - 1) modified for dBASE IV, 1.1,
*-- 2) updated to a function, and 3) the procedure
*-- GetRoman was done away with (combined into the
*-- function).
*-- 04/26/1992 - Jay Parsons - shortened (seriously ...)
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Roman(<nArabic>)
*-- Example.....: ? Roman(32)
*-- Returns.....: Roman Numeral (character string) equivalent of Arabic numeral
*-- passed to it. In example: XXXII
*-- Parameters..: nArabic = Arabic number to be converted to Roman
*-------------------------------------------------------------------------------
parameters nArabic
private cLetrs,nCount,nValue,cRoman,cGroup,nMod
cLetrs ="MWYCDMXLCIVX" && Roman digits
cRoman = "" && this is the returned value
nCount = 0 && init counter
do while nCount < 4 && loop four times, once for thousands, once
&& for each of hundreds, tens and singles
nValue = mod( int( nArabic / 10 ^ ( 3 - nCount ) ), 10 )
cGroup = substr( cLetrs, nCount * 3 + 1, 3 )
nMod = mod( nValue, 5 )
if nMod = 4
if nValue = 9 && 9
cRoman = cRoman + left( cGroup, 1 ) + right( cGroup, 1 )
else && 4
cRoman = cRoman + left( cGroup, 2 )
endif
else
if nValue > 4 && 5 - 8
cRoman = cRoman + substr( cGroup, 2, 1 )
endif
if nMod > 0 && 1 - 3 and 6 - 8
cRoman = cRoman + replicate( left( cGroup, 1 ), nMod )
endif
endif
nCount = nCount + 1
enddo && while nCounter < 4
RETURN cRoman
*-- EoF: Roman()
FUNCTION Arabic
*-------------------------------------------------------------------------------
*-- Programmer..: Ken Mayer (KENMAYER)
*-- Date........: 04/26/1992
*-- Notes.......: This function converts a Roman Numeral to an arabic one.
*-- It parses the roman numeral into an array, and checks each
*-- character ... if the previous character causes the value to
*-- subtract (for example, IX = 9, not 10) we subtract that value,
*-- and then set the previous value to 0, otherwise we would get
*-- some odd values in return.
*-- So far, it works fine.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 07/15/1991 - original function.
*-- 04/26/1992 - Jay Parsons - shortened.
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Arabic(<cRoman>)
*-- Example.....: ?Arabic("XXIV")
*-- Returns.....: Arabic number (from example, 24)
*-- Parameters..: cRoman = character string containing roman numeral to be
*-- converted.
*-------------------------------------------------------------------------------
parameters cRoman
private cRom,cLetrs,nLast,nAt,nVal,cChar,nArabic
cRom = ltrim(trim(upper(cRoman))) && convert to all caps in case ...
cLetrs = "IVXLCDMWY"
nArabic = 0
nLast = 0
do while len( cRom ) > 0
cChar = right( cRom, 1 )
nAt = at( cChar, cLetrs )
nVal= 10 ^ int( nAt/2 ) / iif(nAt/2 = int(nAt/2),2,1)
do case
case nAt = 0
nArabic = 0
exit
case nAt >= nLast
nArabic = nArabic + nVal
nLast = nAt
otherwise
if nAt/2 = int( nAt / 2 )
nArabic = 0
exit
else
nArabic = nArabic - nVal
endif
endcase
cRom = left( cRom, len( cRom ) - 1 )
enddo
RETURN nArabic
*-- EoF: Arabic()
FUNCTION Factorial
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (JPARSONS)
*-- Date........: 03/01/1992
*-- Notes.......: Factorial of a number; returns -1 if number is not a
*-- positive integer.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: None
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: Factorial(<nNumber>)
*-- Example.....: ? Factorial( 6 )
*-- Returns.....: Numeric = number factorial <in example, 6! or 720>
*-- Parameters..: nNumber = number for which factorial is to be determined
*-------------------------------------------------------------------------------
parameters nNumber
private nNext, nProduct
if nNumber # int( nNumber ) .or. nNumber < 1
RETURN -1
endif
nProduct = 1
nNext = nNumber
do while nNext > 1
nProduct = nProduct * nNext
nNext = nNext - 1
enddo
RETURN nProduct
*-- Eof: Factorial()
FUNCTION IsPrime
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (JPARSONS)
*-- Date........: 08/11/1992
*-- Notes.......: Returns .t. if argument is prime positive integer, or .f.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: 03/11/92 - original function.
*-- : 08/11/92 - revised to return .T. for 2. ( Tea for two? )
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: IsPrime(<nNumber>)
*-- Example.....: ? IsPrime( 628321 )
*-- Returns.....: Logical = .t. if prime
*-- Parameters..: nNumber = positive integer to test for being prime
*-------------------------------------------------------------------------------
parameters nNumber
private nFactor, nLimit, lResult
if nNumber < 1 .or. nNumber # int( nNumber ) ;
.or. ( nNumber > 2 .AND. mod( nNumber, 2 ) = 0 )
RETURN .f.
endif
nFactor = 3
nLimit = sqrt( nNumber )
lResult = .t.
do while nFactor <= nLimit
if mod( nNumber, nFactor ) = 0
lResult = .f.
exit
endif
nFactor = nFactor + 2
enddo
RETURN lResult
*-- Eof: IsPrime()
FUNCTION BankRound
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (JPARSONS)
*-- Date........: 03/01/1992
*-- Notes.......: Rounds numeric argument to given number of places,
*-- which if positive are decimal places, otherwise
*-- trailing zeroes before the decimal, in accordance
*-- with the special banker's rule that if the value
*-- lost by rounding is exactly halfway between two
*-- possible digits, the final digit expressed will be even.
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: None
*-- Calls.......: None
*-- Called by...: Any
*-- Usage.......: BankRound(<nNumber>,<nPlaces>)
*-- Example.....: ? BankRound( 357.725, 2 )
*-- Returns.....: Numeric = rounded value ( 357.72 in example )
*-- Parameters..: nNumber = numeric value to round
*-- nPlaces = decimal places, negative being powers of 10
*-------------------------------------------------------------------------------
parameters nNumber, nPlaces
private nTemp
nTemp = nNumber * 10 ^ nPlaces +.5
if nTemp = int( nTemp ) .and. nTemp / 2 # int( nTemp / 2 )
nTemp = nTemp - 1
endif
RETURN int( nTemp ) / 10 ^ nPlaces
*-- Eof: BankRound()
FUNCTION Num2Str
*--------------